SUB BorderLines (parm()) '**************************************************************************** 'Primarily called from other library functions, the BorderLines() SUB draws ' lines on the top and bottom of a pick screen, advising the user of the ' availability of (or lack of) more items that are not currently shown on the ' screen. ' ' parm(1) = row of top line ' parm(2) = row of bottom line ' parm(3) = top element ' parm(4) = bottom element ' parm(5) = min element ' parm(6) = max element ' 'See functions PickOne$() and PickSome$() for examples of use. ' '**************************************************************************** SUB Box (row1, col1, row2, col2, boxtype$) '**************************************************************************** 'Draws a box on the screen at the specified coordinates. row1 & col1 are the ' top left corner, row2 & col2 are the bottom right corner. The appearance ' of the box is determined by boxtype$, which can either be one character to ' pick a predefined box type or a string of 11 or more characters to be used ' as the actual box characters. See the function body of Panes() for the ' exact placement of the characters within the string and other options. ' 'Examples of boxtype$: "1" or "S" Draws a single-line box (default) ' "2" or "D" Draws a double-line box ' "3" or "H" Double Horizontal lines, single vertical ' "4" or "V" Double Vertical lines, single horizontal ' "***********" Draws a box made of asterisks ' '**************************************************************************** SUB BoxCalc (t, l, b, r, tall, wide) '**************************************************************************** 'This function is used by other functions that draw pop-up boxes to calculate ' the box coordinates. ' 'The box coordinates passed as t, l, b and r will be directly modified by the ' sub to contain the desired values. ' 'See EditBox(), PickBox(), ListBox() and Progress() for examples of use. ' '**************************************************************************** FUNCTION Capitalize$ (orig$) '**************************************************************************** 'Capitalizes the first letter of each word in a string after first converting ' the whole thing to lower case. '**************************************************************************** SUB Center (row, text$) '**************************************************************************** 'Centers text on the specified row. '**************************************************************************** FUNCTION ColorSet (hdr1$, hdr2$, parm(), defaults()) '**************************************************************************** 'A handy function to let the user set their color preferences. ' 'The hdr1$ and hdr2$ arugments are text strings that will be centered on the ' first two lines of the screen. ' 'The parm() array will be directly modified by ColorSet(). The function will ' return TRUE if any of the colors were changed, FALSE if they are the same ' as when the function was entered. This is useful if the calling program ' needs to know whether to save the new values in some sort of a setup file ' or not. ' 'The defaults() array should mimic the parm() array. It must have subscripts ' ranging from MINCOLOR to MAXCOLOR at least. ' 'Because this function changes colors and has to mess with the screen a bit, ' it does not restore the previous screen or viewport upon exiting. The ' procedure that calls this function must know to repaint the screen and ' restore any active viewport upon returning. ' '**************************************************************************** FUNCTION CountIn (search$, lookfor$) '**************************************************************************** 'Returns the number of times that a substring is found within a string. '**************************************************************************** FUNCTION Dice (rolls, sides, add) '**************************************************************************** 'Returns the results of the specified dice roll(s). ' 'If you are a role-playing gamer, you will notice that the syntax of this ' function is similar to "standard gaming notation" of dice. For example, ' "3d6" can be easily translated to Dice(3,6,0), or "2d4+1" as Dice(2,4,1). ' '**************************************************************************** FUNCTION Dir$ (file$, DirInfo AS DirType) '**************************************************************************** 'Credit for this function must go to Fairchild Computer Services. The code ' has been altered from the original to suit my purposes. The original is ' available on CompuServe as "DIR.ZIP", and comes with some other good stuff. ' It is one of the most useful things I have ever downloaded. Thank you, FCS ' for sharing your knowledge with the rest of us! ' 'I changed the original function by making the DirType variable a passed ' parameter rather than a COMMON SHARED variable, and altering the format of ' the EntryTime & EntryDate values. ' 'The file$ parameter may be passed as an individual filename, or a filespec ' that includes wildcards and/or extended pathnames - just as if you were ' typing "DIR" at the DOS prompt. ' 'The DirType variable will be filled with other information about the file ' found (if any). See DIR.INC for the type declaration. ' 'If any files match the wildcard, the function will return the filename of ' the first matching file. If a single filename was passed, you'll just get ' the same name back and will then know that the file exists. The DirType ' argument will contain the file's other information. ' 'If no files match the wildcard or the single filename does not exist, Dir$() ' will return a null string ("") and the DirType variable will not be updated ' except with an ErrorCode. ' 'To get further matches to a wildcard, continue to call Dir$() with a null ' file$ argument. Keep doing this until a null string is returned. This ' will indicate that no further files match the wildcard. ' 'Example: ' $INCLUDE: 'DIR.INC' ' DIM DirInfo AS DirType ' f$ = Dir$("*.*", DirInfo) ' IF f$ = "" THEN ' PRINT "No files found" ' ELSE ' PRINT "These files were found:" ' DO ' PRINT f$ ' f$ = Dir$("", DirInfo) ' LOOP UNTIL f$ = "" ' END IF ' 'If there is a problem (such as an invalid pathname) Dir$() will return the ' string "***ERROR***" and the DirType.ErrorCode will contain a value. ' 'Caution: Don't try to run Dir$() against an empty diskette drive. You'll ' hang the computer. Make sure there's a diskette in there first! ' 'See the functions FileExist(), FileSize&() and DirExist() for more examples. ' 'See the functions in DIRSTUFF.BAS for examples of how to interpret the ' values in the DirType variable. ' '**************************************************************************** FUNCTION DirAttr$ (a) '**************************************************************************** 'This function takes as its argument the integer received from the Attribute ' field of a DirType variable (See DIR.INC). It then returns a 5-character ' string with letters representing the file or directory's attributes. ' 'If all the attributes were set, the function would return "DRHSA", where: ' ' D = Directory ' R = Read Only ' H = Hidden ' S = System ' A = Archive ' 'If one or more attributes are missing, their location in the string will be ' blank. ' 'Example: " A" = A file with only an archive attribute. ' " RHS " = A read only, hidden, system file (such as IO.SYS). ' 'This code is also useful to see how you can interpret the values on your ' own. And you thought you would never find a use for the bitwise AND! ' '**************************************************************************** FUNCTION DirDate$ (d&) '**************************************************************************** 'This function converts the long integer value of a DirType.EntryDate into a ' string in the form of MM/DD/YY. '**************************************************************************** FUNCTION DirExist (dirname$) '**************************************************************************** 'The function will return TRUE if the directory in question exists, FALSE ' otherwise. ' 'The dirname$ argument may be passed with or without a trailing backslash. ' 'Note: A null string passed to the function will be interpreted as the ' current directory and the function will return TRUE. ' 'Caution: Attempting to use this function on an empty diskette drive will ' hang your computer. Make sure there is a disk inserted first. ' 'See function MakeDir() for an example of use. ' '**************************************************************************** FUNCTION DirTime$ (t) '**************************************************************************** 'This function takes the integer value of a DirType.EntryTime field and ' converts it to a string in the form of HH:MMa. '**************************************************************************** SUB Drop (text$, row, col) '**************************************************************************** 'Prints text vertically on the screen, dropping from the specified row and ' column position. If the length of the text would continue past row 24, ' printing will stop at that point. See also: SUB Rise() '**************************************************************************** FUNCTION EditBox$ (msg$(), orig$, parm()) '**************************************************************************** 'Basically, it's EdStr$() in a pop-up box. Send an array of text to show ' along with the string to be edited, and the return values are the same as ' EdStr$(). ' ' parm(1) = top left row 0=Center ' parm(2) = top left column 0=Center ' parm(3) = box border type 1-4. See SUB Panes() for numeric boxtypes. ' parm(4) = message justification <0=Left 0=Center >0=Right ' parm(5) = maximum length of the string to be edited 1-77 ' parm(6) = initial insert/overwrite mode (Use the SETCURS.INC constants) ' parm(7) = initial character position within the edit string. ' parm(8) = restrict input? (See EDSTR.INC) ' 'Due to the width of the box & shadow, EditBox$() effectively limits the ' maximum length of the EdStr$() to 77 characters. ' 'If a combination of any of the above parameters causes a portion of the box ' to exceed the screen boundaries, a run-time error will occur. ' 'See function EdStr$() for more detailed information. ' '**************************************************************************** FUNCTION EditBox2$ (msg$, orig$, parm()) '**************************************************************************** 'Exactly the same as EditBox$(), but you pass a single text string as a ' message instead of an array. Just saving you a little coding. ' 'See EditBox$() for all the details. ' '**************************************************************************** FUNCTION EdStr$ (orig$, parm()) '**************************************************************************** 'Used to edit an existing string or for input of a new string. ' 'If the user presses ESC during the editing, CHR$(27) will be returned to let ' the calling procedure know it was aborted. ' 'If Enter is pressed to terminate the editing, the edited string will be ' returned. ' 'The settings of the miscellaneous parameters are as follows: ' ' parm(1) = row ' parm(2) = column ' parm(3) = maximum length of the edited string 1-80 ' parm(4) = insert/overwrite mode (Use SETCURS.INC constants) ' parm(5) = initial cursor position within string 0=Beginning ' parm(6) = use delimiters? (0=No Non-zero=Yes) ' parm(7) = left delimiter ASCII code. Default = 62 ( > ) ' parm(8) = right delimiter ASCII code. Default = 60 ( < ) ' parm(9) = use selected colors? 0=Current colors Non-zero=Selected ' parm(10)= used to restrict user input. See EDSTR.INC for values. ' 'EdStr$() works just like you're used to, with all the familiar editing keys: ' Left/right arrows, Backspace, Delete, Insert/overwrite, Home, and End. It ' also has a special service, Alt-X, that deletes from the cursor position to ' the end of the line. ' 'The maximum length of the edited string depends on whether delimiters are ' used or not. Without delimiters, the string may be up to 80 characters ' long. With delimiters, it is reduced to 78. ' 'If you choose to have EdStr$() appear in the highlighted colors, it will ' reset the colors to normal upon exit. If not, the current color setting ' will not be changed at all. ' 'If parm(10) is greater than zero, user input will be limited to certain ' characters. See EDSTR.INC for the constant names. You may add these ' constants together to get different combinations of allowed characters. ' ' Example: parm(10) = EDUPPER + EDALPHA + EDSPACE ' ' This would allow spaces and uppercase letters only. ' 'The combinations allowed for parm(10) are not extensive by any means, but ' for simple input they can be handy. ' '**************************************************************************** FUNCTION Evaluate$ (formula$) '**************************************************************************** 'This is a special function. It evaluates a "formula" and returns a string ' of the value. If an error is found within the formula (or Evaluate$ is ' just unable to handle it), Evaluate$ will return a string with a leading ' asterisk followed by a description of the error. The best way to see what ' it does is just to experiment. By no means am I sure that this function is ' completely bulletproof, but it will stand up to most expressions whose ' value doesn't exceed a few trillion. This function is a good example of ' recursion if you are interested. ' 'Example: formula$ = "10*4-(36/3)" ' newval$ = Evaluate$(formula$) ' IF left$(newval$,1)="*" then ' PRINT "An error occurred!" ' PRINT newval$ '(Error description) ' ELSE ' PRINT "The value of ";formula$;" is:"; VAL(newval$) ' END IF ' 'Note: MUST be compiled with the /X switch. ' '**************************************************************************** FUNCTION FileExist (file$) '**************************************************************************** 'Returns TRUE or FALSE depending on whether the specified file exists. If ' used with a wildcard, it will return TRUE if any file matches the wildcard. '**************************************************************************** FUNCTION FileParts$ (filespec$, operation$) '**************************************************************************** 'Returns a specified part of an extended filename or other filespec type ' string. ' 'The return value depends upon the value of the operation$ argument: ' 'Example: filespec$ = "C:\GAMES\SAVEGAME.001" ' FileParts$(filespec$,"P") --> "C:\GAMES\" (Path) ' FileParts$(filespec$,"F") --> "SAVEGAME.001" (Filename) ' FileParts$(filespec$,"E") --> "001" (Extension) ' FileParts$(filespec$,"N") --> "SAVEGAME" (fileName) ' FileParts$(filespec$,"D") --> "C:" (Drive) ' ' filespec$ = "HOMEWORK.TXT" ' FileParts$(filespec$,"P") --> "" Returns null if the requested ' FileParts$(filespec$,"D") --> "" info is not part of filespec$ ' 'Paths are returned with a trailing backslash. Drive letters are returned ' with a trailing colon. Extensions are returned without a leading period. ' 'Quirks: FileParts$() assumes that all pathnames end in a backslash. If you ' pass the function one that does not, it will think that it is a filename: ' ' Example: "C:\GAMES" will be interpreted as a file called "GAMES" in the ' root directory of C:. "C:\GAMES\" would be Ok. ' 'Note: The letter "X" is accepted as well as "E" to get the extension. ' '**************************************************************************** FUNCTION FileSize& (file$) '**************************************************************************** 'Returns a long integer representing the file size of a single file or the ' combined size of multiple files if a wildcard is passed. ' 'Should the file(s) not be found, the function will return zero. ' '**************************************************************************** FUNCTION GenMen (choice$(), ok(), parm()) '**************************************************************************** 'GenMen() is a general vertical lightbar menu function. It will return the ' element number of the selected item or zero if the user presses ESC. ' 'The ok() array is used to specify which choices are available: ' ' 0=Not available Non-zero=Ok ' 'The ok() array must have subscripts equal to those of choice$() or those ' specified by parm(6 and 7) - See below. ' ' parm(1) = top row ' parm(2) = left column 0=Center ' parm(3) = # blank lines between choices >=0 ' parm(4) = allow number keys if < 10 choices? 0=No Non-zero=Yes ' parm(5) = initial selected choice ' parm(6) = minimum choice$() subscript 0=Use actual minimum (LBOUND) ' parm(7) = maximum choice$() subscript 0=Use actual maximum (UBOUND) ' 'If a combination of any of the above parameters cause one or more menu items ' to be placed outside the actual screen area, a run-time error will occur. ' 'parm(4) indicates whether the user can press a number key (1-9) to select an ' option when there are 9 or less choices. Identifying the choices by number ' is the programmer's responsibility if this option is desired. Note: this ' option can only be selected when all the choice$() subscripts are positive. ' ' Example: choice$(1) = " 1) Do this " ' choice$(2) = " 2) Do that " ' choice$(3) = " 3) Do the other " ' 'parm(6 and 7) can specify minimum and maximum elements of the array to use ' if the actual array contains more elements than you want on the menu. ' ' Example: DIM choice$(-10 to 30) This example would create ' (assign values to choice$()...) a lightbar menu using only ' parm(6) = 1 choices 1 through 5, ' parm(7) = 5 ignoring any element below ' picked = GenMen(...) 1 or over 5. ' 'Note: It is not recommended to include subscript zero in the choices sent to ' GenMen(). You will be unable to tell the difference between the user ' selecting element zero and the user pressing ESC. Exception: When element ' zero is some sort of quit or exit option this might be acceptable. ' '**************************************************************************** FUNCTION GenMen2 (choice$(), parm()) '**************************************************************************** 'GenMen2() is identical to GenMen() except that you need not pass the ok() ' array. All elements default to available. ' 'See GenMen() for more information. The parm() settings are identical. ' '**************************************************************************** FUNCTION GetKey$ (parm()) STATIC '**************************************************************************** 'Used to control user input. It includes a screensaver routine and a way to ' trap hotkeys with polling rather than ON KEY. Use it where you would ' normally place an INKEY$ loop. ' 'Chances are, you will want to modify this function for each program that you ' write. See below for information about how the screensaver works and how ' to add hotkey procedures. ' '**************************************************************************** FUNCTION HomePath$ '**************************************************************************** 'Returns the name of the current DOS directory. '**************************************************************************** SUB InfoBox (msg$(), parm()) '**************************************************************************** 'Displays the text of the msg$() array in a pop-up box. Basically, it is ' just a call to PickBox() with only one option of " Ok ". ' ' parm(1) = top left row 0=Center ' parm(2) = top left column 0=Center ' parm(3) = box border type 1-4. See SUB Panes() for numeric boxtypes. ' parm(4) = message justification <0=Left 0=Center >0=Right ' 'See function PickBox() for more detailed information. ' '**************************************************************************** SUB InfoBox2 (msg$, parm()) '**************************************************************************** 'Works just like InfoBox() but accepts a single text string rather than an ' array. ' ' parm(1) = top left row 0=Center ' parm(2) = top left column 0=Center ' parm(3) = box border type 1-4. See SUB Panes() for numeric boxtypes. ' parm(4) = message justification <0=Left 0=Center >0=Right ' 'See functions InfoBox() and PickBox() for more detailed information. ' '**************************************************************************** FUNCTION IsAlpha (text$) '**************************************************************************** 'Returns TRUE if the text contains only letters and spaces, otherwise FALSE. '**************************************************************************** FUNCTION IsNum (text$) '**************************************************************************** 'Returns TRUE if the text contains only numeric data, FALSE otherwise. ' 'The function considers a lone minus sign (-) to be an operator, not numeric. ' The same goes for a lone decimal point. Both characters ARE allowed if ' cohabitating with digits (would their mothers approve?). ' 'Examples: IsNum("12") --> TRUE IsNum("ABC") --> FALSE ' IsNum("-6") --> TRUE IsNum(" ") --> FALSE ' IsNum("1.3") --> TRUE IsNum("-") --> FALSE ' IsNum("") --> FALSE IsNum(".") --> FALSE ' '**************************************************************************** FUNCTION Istr$ (i) FUNCTION Lstr$ (l&) FUNCTION Sstr$ (s!) FUNCTION Dstr$ (d#) '**************************************************************************** 'These functions simply make a string of a number and trim the leading space ' off of it. The four differenct functions are for the different numeric ' variable types: Double precision, Integer, Long integer and Single ' precision. ' 'They are not very complicated, but since I use the combination of LTRIM$() ' and STR$() so often, I might as well make my life easier. ' '**************************************************************************** FUNCTION Justify$ (orig$, side) '**************************************************************************** 'Moves leading or trailing spaces to the appropriate side of the string, ' while retaining the original length of the string. ' 'The side argument can take one of the following forms: ' ' <0 = Left justify (move leading spaces to the right side) ' 0 = Center justify (spread spaces evenly on both sides) ' >0 = Right justify (move trailing spaces to the left side) ' 'The function works by comparing the size of the original string to the size ' of the string after trimming the appropriate spaces. These spaces are then ' tacked back on to the appropriate side. ' 'Examples: Justify$("Some text ", 0) --> " Some text " ' Justify$("Some more ", 1) --> " Some more" ' Justify$(" Even more!",-1) --> "Even more! " ' '**************************************************************************** FUNCTION LeadZero$ (number, newlen) '**************************************************************************** '"Stringifys" an integer and pads it on the left with leading zeros up to the ' desired length. ' 'This function was created mainly due to PRINT USING's inability to add ' leading zeros (But you can add asterisks! Gee, I use that a lot. NOT!!). ' Feel free to create additional functions that work on other data types. ' 'Note: If used on a negative number, the minus sign will be included when ' calculating the new length. ' ' Examples: LeadZero$(5,5) --> "00005" ' LeadZero$(-5,5) --> "-0005" ' '**************************************************************************** FUNCTION ListBox (title$, choice$(), parm()) '**************************************************************************** 'ListBox() works just like PickOne(), but it appears in a pop-up box. It ' returns the element number of the item selected or zero if the user pressed ' ESC. There are no hotkeys in ListBox(). ' 'The title$ argument will be centered on the top border of the box. If no ' title is desired, pass a null string. ' 'The width of the box is determined by the longer of the title or longest ' choice$() element. ' ' parm(1) = top row 0=Center ' parm(2) = left column 0=Center ' parm(3) = box border type 1-4. See SUB Panes() for numeric boxtypes. ' parm(4) = initial selected choice ' '**************************************************************************** FUNCTION MakeDir (directory$) '**************************************************************************** 'Creates a DOS directory. Unlike the MKDIR command, MakeDir() can create a ' directory more than one level deep or on a different drive. ' 'The directory$ argument may be passed with or without a trailing backslash. ' 'Returns TRUE if successful, FALSE if unable to create the directory. If ' unable to create the directory, MakeDir() DOES NOT clean up after itself by ' removing any partially created subdirectories. ' 'If creating a multi-level subdirectory, it is best to pass the whole ' pathname, including the drive letter. ' 'Examples: MakeDir("GAMES") Creates a subdirectory "GAMES" off the current ' directory. ' ' MakeDir("C:\SCIENCE\DATA") Creates the specified directory. If ' the \SCIENCE directory doesn't exist, ' it will get created too. This would ' crash the MKDIR command. ' 'Note: MUST be compiled with the /X switch due to the RESUME NEXT stuff. ' 'Caution: If using MakeDir() on a floppy drive, MAKE SURE that there is a ' diskette in the drive or your computer will hang. ' '**************************************************************************** FUNCTION Dmax# (a#, b#) FUNCTION Dmin# (a#, b#) FUNCTION Imax (a, b) FUNCTION Imin (a, b) FUNCTION Lmax& (a&, b&) FUNCTION Lmin& (a&, b&) FUNCTION Smax! (a!, b!) FUNCTION Smin! (a!, b!) '**************************************************************************** 'The various max() and min() functions simply return the larger or smaller of ' two numbers. There is one set of functions for each of the numeric data ' types. ' 'While useful by themselves, they can be extremely handy when used in pairs: ' ' biggest = Imax(a, Imax(b, c)) ' ' smallest! = Smin!(a!, Smin!(b!, c!)) ' '**************************************************************************** FUNCTION PadC$ (orig$, newlen) FUNCTION PadL$ (orig$, newlen) FUNCTION PadR$ (orig$, newlen) FUNCTION PadX$ (orig$, newlen, side, char$) '**************************************************************************** 'Pads a string with a specified character on the specified side(s) up to the ' new length. A more flexible version of the other "Pad" functions (all of ' which are merely translated into calls to PadX$() with a space for the pad ' character!). ' 'The side argument is expressed like so: <0 = Left ' 0 = Center ' >0 = Right ' 'Examples: PadX$("Hello!",10,1," ") --> "Hello! " ' PadX$("$500",10,-1,"*") --> "******$500" ' PadX$("WOW",20,0,"!") --> "!!!!!!!!WOW!!!!!!!!!" ' '**************************************************************************** SUB Panes (row1, col1, row2, col2, row3, col3, boxtype$) '**************************************************************************** 'Draws a box on the screen at the specified coordinates. row1 & col1 are the 'top left corner, row2 & col2 are the bottom right corner. row3 & col3 are 'parameters specifying where the box is to be split horizontally and/or 'vertically. If either or both row3 or col3 are zero, the box will not be 'split in that direction. Experiment with it. ' 'The appearance of the box is determined by boxtype$, which can either be one 'character to pick a predefined box type or a string of 11 or more characters 'to be used as the actual box characters. See the function body for the 'exact placement of the characters within the string. ' 'Examples of boxtype$: "1" or "S" Draws a single-line box (default) ' "2" or "D" Draws a double-line box ' "3" or "H" Double horizontal lines, single vertical ' "4" or "V" Double vertical lines, single horizontal ' "***********" Draws a box made of asterisks ' 'The box can be drawn as an outline only, not overwriting anything within the ' box's borders or can be filled with a fill character, effectively placing ' the box over whatever was already there. This option is also controlled by ' the boxtype$ argument: ' 'If boxtype$ is specified as a number ("1", "2"...) the box will be drawn as ' an outline only. If boxtype$ is specified as a letter ("S", "D"...) the ' box will be filled with spaces. ' 'If boxtype is a user-supplied string of characters, if it's length is 12 or ' more, the 12th character will be used as the fill character, otherwise the ' box will be drawn as an outline. ' '**************************************************************************** FUNCTION ParseDie$ (die$) '**************************************************************************** 'This function takes a string in "standard gaming notation" and returns a ' string of the stated dice roll's value. ' 'If the die$ string begins with an asterisk (*), ParseDie$() will interpret ' it as a constant (non-random value) and will return whatever follows the ' asterisk. ' 'If an illegal character is found in the string, the return value will begin ' with an at-sign (@) followed by the string position of the offending ' character. The following characters are recognized by ParseDie$(): ' ' *0123456789dD+- (spaces are ignored) ' 'Remember that the Dice() function accepts only integer arguments and returns ' and integer. If the result of the die roll (or any of its parts) exceeds ' the limits of an integer variable (-32,768 to 32,767) a run-time error will ' occur. If you need more, just rewrite these functions using long integers. ' ' Examples: ParseDie$("3d6") --> "3" to "18" ' ParseDie$("1d4+1") --> "2" to "5" ' ParseDie$("*15") --> "15" ' ParseDie$("2d3.1") --> "@4" (Illegal character in 4th pos.) ' ParseDie$("") --> "0" ' ParseDie$(" ") --> "1" to "4" (Defaults to 1d4) ' ParseDie$("2d50000") Crash! ' '**************************************************************************** FUNCTION PickBox (msg$(), choice$(), parm()) '**************************************************************************** 'Allows the user to pick from a horizontal light-bar menu within a pop-up ' message box. ' 'The informational text of the box is contained within the msg$() array. ' 'The choice$() array contains the items the user may pick from. The function ' will return the element number of the item selected, or zero if the user ' presses ESC. ' ' parm(1) = top left row 0=Center ' parm(2) = top left column 0=Center ' parm(3) = box border type 1-4. See SUB Panes() for numeric boxtypes. ' parm(4) = message justification <0=Left 0=Center >0=Right ' parm(5) = initial selected choice ' 'If a combination of any of the above parameters causes a portion of the box ' to exceed the screen boundaries, a run-time error will occur. ' '**************************************************************************** FUNCTION PickInfo$ (p$, k, e) '**************************************************************************** 'This function interprets the return string from the PickOne$() and ' PickSome$() functions. ' 'The return value from the Pick function is passed as p$. The integer ' variables passed as k and e will be assigned the value of the keypress and ' element number respectively. ' 'PickInfo$() returns the actual character value of the keypress used to exit ' the Pick function. ' 'See the comments within PickOne$() for a more detailed explanation of the ' Pick functions' return values. ' 'Examples: k$ = PickInfo$("", k, e) --> k$ = CHR$(27) ' k = 27 ' (User pressed ESC) e = 0 ' ' k$ = PickInfo$("*-59 4", k, e) --> k$ = CHR$(0)+CHR$(59) ' k = -59 ' (User pressed F1 on element 4) e = 4 ' ' k$ = PickInfo$("19", k, e) --> k$ = CHR$(13) ' k = 13 ' (User pressed Enter on element 19) e = 19 ' 'Note: This function is a good example of how to get more than one return ' value from a function. ' '**************************************************************************** FUNCTION PickOne$ (choice$(), parm()) '**************************************************************************** 'Allow the user to select an item from an array by highlighting it with the ' cursor keys & pressing Enter. The function returns a string of the item's ' element number, or a null string if the user ESCapes. Other options are ' available, and are specified in parm(). ' ' parm(1) = top row ' parm(2) = bottom row ' parm(3) = column width 0=Calculated by the function (recommended) ' parm(4) = initial selected element # ' parm(5) = reset? 0=Subsequent call Non-zero=Reset ' 'Any column width specified in parm(3) will be increased by 2 to allow for ' spaces on either side of each item. Allow for this when supplying this ' value. ' 'parm(6 to 10) are special parameters, designating "hotkeys" that will return ' control to the calling procedure, and return a string of the key pressed ' along with the element number of the currently highlighted item. If no ' hotkey is desired, merely pass a zero for that parameter. ' 'To specify a one-byte INKEY$ code, merely pass the ASCII code of the key. ' If the key is a letter, pass the upper-case ASCII code. To specify a two- ' byte key, pass the negative ASCII code of the second byte. ' ' Examples: To specify the backspace key, pass 8 ( CHR$(8) ). ' To specify the F1 key, pass -59 ( CHR$(0)+CHR$(59) ). ' 'The string returned when a hotkey is pressed will consist of an asterisk ' followed by the hotkey code specified in the parm() array, a space, and the ' current element number. ' ' Example: "*-59 4" would mean that the F1 key was pressed while element #4 ' was highlighted. ' 'When returning to the function after processing a hotkey, make sure that ' parm(4) is updated to reflect the current element, and parm(5) is zero. ' If calling the function for the first time, make sure parm(5) is non-zero. ' '**************************************************************************** FUNCTION PickSome$ (choice$(), tag(), parm()) '**************************************************************************** 'PickSome$() works just like the PickOne$() function but also allows for the ' tagging of multiple items. See PickOne$() for general information about ' how these functions work. Additional information on how the tagging works ' is described here. ' ' parm(1) = top row ' parm(2) = bottom row ' parm(3) = column width 0=Calculated by the function (recommended) ' parm(4) = initial selected element # ' parm(5) = reset 0=Subsequent call Non-zero=Reset ' parm(6) = tagging key Default=32 (spacebar) ' parm(7) = tag all key Default=-66 (F8) ' parm(8) = tag none key Default=-67 (F9) ' parm(9) = switch tags key Default=-68 (F10) ' parm(10) can be specified as another hotkey (see PickOne$()) ' 'The tagging keys specified by parm(6 to 9) may be disabled by passing -1. ' The default will be assigned if zero is passed. ' The tagging key will toggle an individual item's tag to on (1) or off (0). ' The tag all/tag none keys will set all items' tags to on/off respectively. ' The switch tags key will change all on tags to off, and all off tags to on. ' 'The tag array must be an integer array with subscripts identical to the ' choice$() array. You may pre-tag items or disable items in the array by ' setting elements of tag() to one of the following values: ' ' 0 = Untagged/Off 1 = Tagged/On -1 = Disabled ' 'If an item is disabled, it will be unaffected by any tagging operations and ' will appear in the dimmed color specified by parm(FGD) and/or parm(FGDS). ' '**************************************************************************** SUB PopBox (t, l, b, r, wide, msg$(), parm()) '**************************************************************************** 'This function is used by other pop-up box functions to zap the box onto the ' screen. The procedure that calls this function must have its parm(3 & 4) ' arguments set up like so: ' ' parm(3) = box border type 1-4 ' parm(4) = message justification <0=Left 0=Center >0=Right ' 'See EditBox(), PickBox(), and Progress() for examples of use. ListBox() is ' not included because it doesn't have a msg$() array. ' '**************************************************************************** SUB Progress (cur, msg$(), parm()) STATIC '**************************************************************************** 'Displays a percentage progress bar in a pop-up box. The actual numeric ' progress is also shown. The progress bar is updated in 5% increments. ' ' parm(1) = top left row 0=Center ' parm(2) = top left column 0=Center ' parm(3) = box border type 1-4. See SUB Panes() for numeric boxtypes. ' parm(4) = message justification <0=Left 0=Center >0=Right ' parm(5) = maximum: (cur/maximum)*100 = percentage complete ' 'The function has three different uses. The first will draw the box on the ' screen. The second usage will update the progress bar in the currently ' displayed box. The third will remove the box from the screen. ' 'The cur argument is used to indicate what you want Progress() to do: ' ' 0 = New box ' >0 = Update current box (cur/maximum)*100 = % ' <0 = Remove box ' 'Only one box may be on screen at any one time. If you specify an operation ' that conflicts with the current status of the sub (like requesting a new ' box when there's already one up) nothing will happen. ' 'Once the box is on screen, you should not do any PRINTing. This should not ' be a problem, as the main usage for this function is for when some major ' processing is going on and you want the user to know that their computer ' is actually doing something. ' 'Another feature of Progress() is the fact that it will always appear for at ' least 1.5 seconds. Have you ever used a program & had some message flash ' by before you got a chance to read it? Pretty annoying, isn't it. ' '**************************************************************************** SUB RestScreen (filename$) '**************************************************************************** 'Restores a screen saved by SaveScreen(). ' 'You should only pass a filename that you know contains data created by the ' SaveScreen() sub. I have no idea what would happen if you used any other ' kind of data. Use at your own risk. If you pass a filename that does not ' exist, a run-time error will occur. ' '**************************************************************************** FUNCTION Rinstr (start, search$, lookfor$) '**************************************************************************** 'Kind of a "Reverse INSTR" (hence the name). Returns the character position ' of the LAST occurrence of a substring within another. ' 'If the start argument is greater than zero, search$ is truncated to ' (start-1) before the search begins (I would rather have called it "end" but ' that word is taken). The start argument is especially useful for ' subsequent calls to Rinstr, i.e., to find the second-to-last occurrence, ' etc. ' 'Examples: Rinstr(0,"Peter Piper","er") --> 10 ' Rinstr(10,"Peter Piper","er") --> 4 (Searches "Peter Pip") ' '**************************************************************************** SUB Rise (text$, row, col) '**************************************************************************** 'Prints text vertically on the screen, rising from the specified row and ' column position. If the length of the text would continue above row 1, ' printing will stop at that point. See also: SUB Drop() ' '**************************************************************************** SUB SaveScreen (filename$) '**************************************************************************** 'Saves the current text screen to the specified binary file. If the file ' already exists, it will be overwritten. ' 'This function was only tested in text mode (SCREEN 0). I have no idea what ' it would do in any other screen mode. Use at your own risk. ' '**************************************************************************** FUNCTION SetCargo$ (c$) STATIC '**************************************************************************** 'This is a general set/get function that operates on a string. To query the ' current value of SetCargo$() without actually changing its value, pass ' CHR$(0) as the argument. '**************************************************************************** FUNCTION SetCursor (cursortype) STATIC '**************************************************************************** 'A set/get function for turning the cursor on and off and changing its ' appearance. ' 'Be sure to include the SETCURS.INC in the calling program and use its ' constants as arguments to the function. ' 'To inquire on the current setting without changing it, pass a negative ' number as an argument (or anything besides one of the defined constants). ' '**************************************************************************** SUB SetView (top, bot, parm()) STATIC '**************************************************************************** 'Used to set the current text viewport (VIEW PRINT) and update the changes in ' the parm() array. ' 'To change the current viewport settings, pass the appropriate values in the ' top and/or bot arguments. Setting both values to zero will have the effect ' of releasing the active VIEW PRINT setting and restoring the viewport to ' the entire screen. ' 'To reset the the viewport to the values currently stored in parm() without ' changing either value, pass negative numbers for both arguments. ' 'Examples: SetView 0, 0, parm() --> Sets viewport to the entire screen. ' SetView 4, 24, parm() --> Sets viewport to rows 4 through 24. ' SetView 6, 0, parm() --> Updates the top row of the viewport ' to 6, leaving the current value for ' the bottom row unchanged. ' SetView -1, -1, parm() --> Resets the viewport to the values ' currently stored in parm() without ' changing either value. ' '**************************************************************************** SUB Slide (text$, lr, row, col, delay) '**************************************************************************** 'Slides text onto the screen to the left or right starting at the specified ' row and column. ' 'The direction is determined by the argument lr, where a zero value equals ' left, non-zero equals right. ' 'delay is measured in 100ths of a second. ' '**************************************************************************** SUB Spread (text$, row, col, delay) '**************************************************************************** 'Spreads text on the screen in both directions starting from the specified 'coordinates. Delay is measured in 100ths of a second. '**************************************************************************** FUNCTION Squeeze$ (orig$, char$) '**************************************************************************** 'Removes all occurrences of a substring from within a string. ' 'Example: Squeeze$("Peter Piper","er") --> "Pet Pip" ' '**************************************************************************** FUNCTION Strip$ (orig$, side, char$) '**************************************************************************** 'Strips leading and/or trailing characters from a string. It works like ' LTRIM$() and RTRIM$() but on other characters in addition to spaces. ' 'The side argument is passed in one of the following ways: ' ' <0 = Strip the left side ' 0 = Strip both sides ' >0 = Strip the right side ' 'Combinations of characters can also be stripped from each side as well as ' individual characters. In this case, the length of char$ would be greater ' than one. The characters to be stripped ARE case sensitive. ' 'Examples: Strip$("00100",-1, "0") --> "100" ' Strip$("AABAa", 0, "A") --> "BAa" ' Strip$("00100", 0, "0") --> "1" ' Strip$(" ", 0, " ") --> "" ' Strip$("ABCDE", 0, "AB") --> "CDE" ' Strip$("ABCDE", 1, "AB") --> "ABCDE" ' '**************************************************************************** FUNCTION Stuff$ (orig$, position, delnum, char$) '**************************************************************************** 'Inserts and/or deletes character(s) in(to) a string at the specified ' character position. Very simple, but very useful. ' 'The position argument tells the function where to start its operations upon ' the original. ' 'The delnum argument tells it how many (if any) characters to delete starting ' at that position. ' 'The value of char$ determines what gets put into the string at position. If ' null, nothing will get put in, effectively deleting characters from within ' the string. ' 'Examples: Stuff$("QBasic",2,0,"uick") --> "QuickBasic" (Adds characters) ' Stuff$("Landlocked",5,4,"") --> "Landed" (Deletes characters) ' Stuff$("Trifle",4,1,"bb") --> "Tribble" (Replaces characters) ' 'Specifying a delnum of zero and a null char$ will do nothing. ' '**************************************************************************** SUB TeleType (text$, delay) '**************************************************************************** 'Prints text one character at a time beginning at the current cursor location. ' 'The delay between each character being printed is measured in 1/100ths of a ' second (a delay of 100 would equal one second). If a value of zero or less ' is specified, the delay defaults to 5/100ths of a second. If a key is ' pressed during the SUB, the remainder of the string is printed without any ' delay. ' 'You could easily add some sound to this procedure. I recommend using SOUND ' 20000,1 after each letter except spaces and a delay of at least 7. ' '**************************************************************************** FUNCTION TempName$ (path$) STATIC '**************************************************************************** 'Used to create a temporary filename. The filename will reside in the ' specified path, or in the current directory if path$ is null. ' 'The path$ argument may be passed with or without a trailing backslash. ' 'The filename will consist of a leading underscore, the current value of the ' system timer, and an extension of ".TMP". ' 'This standardized naming of temporary files will make it easy to delete any ' leftover temporary files all at once with a wildcard. ' ' Example filenames: _4573921.TMP _230117.TMP ' ' Example deletion command: KILL "_*.TMP" ' 'The filename given by TempName$() is stored in a static variable in case the ' function is called more than once in the same 100th of a second (It's not ' as unlikely as you think). This allows you to get two or more temporary ' filenames without having to create each one before getting the next one. ' The function can produce about 20 filenames per second when called in ' rapid succession. When called normally (once), I was unable to measure the ' time it took. ' 'See function HomePath$() for an example of use. ' '**************************************************************************** FUNCTION VPage (p) STATIC '**************************************************************************** 'This function is used to allocate and release pages of video memory. ' 'To request (allocate) a page, pass zero as the argument. The function will ' return the page number that has been allocated, or zero if none are left. ' 'To release a video page when your procedure is finished with it, pass the ' page number as the argument to the function. The function will note the ' page as being available, and will return zero. ' 'The reason behind the function is so that procedures that need to use or ' swap video pages can do so without fear of using a page that may already ' be in use by another procedure. ' 'The function doesn't actually do anything at all with video pages. It ' merely keeps track of a small array that remembers which pages are in use. ' 'NOTE: This function assumes VGA video with 8 pages (0-7) of video memory for ' screen mode 0. It also assumes that page 0 is always in use, and does not ' bother to keep track of it. ' 'See function ColorSet() or any of the pop-up box functions for examples of ' use. ' '**************************************************************************** SUB Wipe (row) '**************************************************************************** 'Clears a row on the screen. '**************************************************************************** SUB WipeArea (row1, col1, row2, col2) '**************************************************************************** 'Clears an area of the screen. '**************************************************************************** FUNCTION YesNo (msg$(), yesword$, noword$, parm()) '**************************************************************************** 'Works like PickBox() but returns TRUE if the yes option is selected or FALSE ' if the no option is selected or ESC is pressed. ' ' parm(1) = top left row 0=Center ' parm(2) = top left column 0=Center ' parm(3) = box border type 1-4. See SUB Panes() for numeric boxtypes. ' parm(4) = message justification <0=Left 0=Center >0=Right ' parm(5) = initial selected choice as TRUE or FALSE ' 'The function defaults to the words " Yes " and " No ". If these are what ' you want, pass null strings for the optional words. Common alternatives ' might be " Ok " and " Cancel ". ' 'See function PickBox() for more detailed information. ' '**************************************************************************** FUNCTION YesNo2 (msg$, yesword$, noword$, parm()) '**************************************************************************** 'Works like YesNo() but accepts a single message string rather than an array. ' ' parm(1) = top left row 0=Center ' parm(2) = top left column 0=Center ' parm(3) = box border type 1-4. See SUB Panes() for numeric boxtypes. ' parm(4) = message justification <0=Left 0=Center >0=Right ' parm(5) = initial selected choice as TRUE or FALSE ' 'See functions YesNo() and PickBox() for more detailed information. ' '****************************************************************************